(load "prelude.ss")

;; (define (leftmost lat)
;;   (let ((head (car lat)))
;;    (if (atom? head)
;;        head
;;        (leftmost head))))

;; Page 65
(define (leftmost l)
  (cond ((null? l) '())
        ((atom? (car l)) (car l))
        (else (cond
                ((atom? (leftmost (car l)))
                 (leftmost (car l)))
                (else (leftmost (cdr l)))))))

;; Page 66
(define (leftmost l)
  (cond ((null? l) '())
        ((atom? (car l)) (car l))
        (else (let ((a (leftmost (car l))))
                (cond ((atom? a) a)
                      (else (leftmost (cdr l))))))))

;; Page 68
;; Remove the leftmost a in l
(define (rember1* a l)
  (letrec
    ((R (lambda (l)
          (cond ((null? l) '())
                ((atom? (car l))
                 (cond ((eq? (car l) a) (cdr l))
                       (else (cons (car l) (R (cdr l))))))
                (else
                  (let ((av (R (car l))))
                   (cond ((eqlist? av (car l))
                          (cons (car l) (R (cdr l))))
                         (else (cons av (cdr l))))))))))
    (R l)))

;; Page 69
(define (depth* l)
  (cond ((null? l) 1)
        ((atom? (car l)) (depth* (cdr l)))
        (else (max (add1 (depth* (car l)))
                   (depth* (cdr l))))))

;; Page 78
(define (leftmost l)
  (letcc skip
         (letrec
           ((lm (lambda (l)
                  (cond
                    ((null? l) '())
                    ((atom? (car l)) (skip (car l)))
                    (else (let ()
                           (lm (car l))
                           (lm (cdr l))))))))
           (lm l))))

;; Page 84
(define rm
  (lambda (a l oh)
    (cond
      ((null? l) (oh 'no))
      ((atom? (car l))
       (if (eq? (car l) a)
           (cdr l)
           (cons (car l)
                 (rm a (cdr l) oh))))
      (else (let ((new-car (letcc oh (rm a (car l) oh))))
             (if (atom? new-car)
                (cons (car l)
                      (rm a (cdr l) oh))
                (cons new-car
                      (cdr l))))))))

(define (rember1* a l)
  (try oh (rm a l oh) l))

;; Page 89
(define rm
  (lambda (a l oh)
    (cond
      ((null? l) (oh 'no))
      ((atom? (car l))
       (if (eq? (car l) a)
           (cdr l)
           (cons (car l)
                 (rm a (cdr l) oh))))
      (else (try oh2
                 (cons (rm a (car l) oh2)
                       (cdr l))
                 (cons (car l)
                       (rm a (cdr l) oh)))))))

